home *** CD-ROM | disk | FTP | other *** search
/ The 640 MEG Shareware Studio 2 / The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO / pascal / tpu6.zip / TPU6EQU.PAS < prev    next >
Pascal/Delphi Source File  |  1991-04-16  |  4KB  |  108 lines
  1. Unit TPU6EQU;
  2.  
  3. { -------------------------------------------------------------    }
  4. { This UNIT defines CONSTs, TYPEs, PROCEDUREs and FUNCTIONs of  }
  5. { general utility to the program.  It also enables a Heap Error }
  6. { Function which causes the Heap Manager to return NIL if any   }
  7. { Heap Allocation Request (NEW or GETMEM) finds insufficient    }
  8. { Heap Space to satisfy the request.  Two variables are defined }
  9. { which allow tracking of Heap utilization to be performed by a }
  10. { using program.  There is very little in this unit that is     }
  11. { specific to ".TPU" files per-se.                }
  12. { ------------------------------------------------------------- }
  13.  
  14. (*****************)
  15. (**) INTERFACE (**)    Uses Dos;
  16. (*****************)
  17.  
  18. Const    _UnitEye = 'TPU9';        { Identifies TP6 Units          }
  19.     _Library = 'TURBO.TPL';        { Turbo Pascal Unit Library Name }
  20.  
  21.     _FilNamLen = SizeOf(Dos.NameStr)+SizeOf(Dos.ExtStr)-2;
  22.         _FilDirLen = SizeOf(Dos.DirStr)-1+_FilNamLen;
  23.  
  24. Type    _UnitName = String[8];        { Max Size of a Unit Name     }
  25.     _FileSpec = String[_FilNamLen];    { Max Size of Name.Extension  }
  26.         _FileXpnd = String[_FilDirLen];    { Max Size of above plus Path }
  27.         _LexName  = String[63];        { Max Size of Pascal Names    }
  28.       _StrByte  = String[2];        { String for Hex Byte Display }
  29.     _StrWord  = String[4];          { String for Hex Word Display }
  30.  
  31.         _Paragraph= Array[0..15] of Byte;    { 8086 Paragraph Size }
  32.  
  33. Var     _HeapHighWaterMark,        { Max Heap Utilization Pointer }
  34.     _HeapOriginalMark : Pointer;    { Min Heap Utilization Pointer }
  35.  
  36. Function  PtrNormal(P : Pointer): Pointer;    { Normalizes a Pointer }
  37. Function  PtrDelta(P,Q: Pointer): LongInt;    { Pointer Differential }
  38. Function  HexB(Arg:Byte): _StrByte;        { Byte to Hex String   }
  39. Function  HexW(Arg:Word): _StrWord;        { Word to Hex String   }
  40.  
  41. (**********************)
  42. (**) IMPLEMENTATION (**)
  43. (**********************)
  44.  
  45.   { Function Below Converts POINTER to Normalized Form }    {.CP22}
  46.   { Version 6.0 of TURBO Pascal is Mandatory for This  }
  47.  
  48. FUNCTION  PtrNormal(P : Pointer) : Pointer;
  49. Var I, J : Word;
  50. Begin
  51.    I := Seg(P^); J := Ofs(P^);
  52.    ASM
  53.       XOR   DX,DX    { make a zero            }
  54.       MOV   CX,4        { set shift magnitude        }
  55.       MOV   AX,J        { fetch OFFSET part        }
  56.       ADD   AX,7        { round up to QWORD boundary    }
  57.       RCR   DH,CL       { save CF in DX bit 12        }
  58.       MOV   BX,00008h   { set AND mask for offset     }
  59.       AND   BX,AX       { form normalized OFFSET    }
  60.       MOV   J,BX        { save normalized OFFSET     }
  61.       SHR   AX,CL       { align OFFSET for SEGMENT     }
  62.       ADD   AX,DX    { add saved CF for SEGMENT Wrap }
  63.       ADD   I,AX        { normalize SEGMENT part    }
  64.    End;
  65.    PtrNormal := Ptr(I,J)  { return "normalized" pointer }
  66. End; {PtrNormal}
  67.  
  68.   { Function Below Computes the SIGNED Difference between the }    {.CP11}
  69.   { EFFECTIVE Values of two pointers, P and Q.  The result is }
  70.   { negative if P^ < Q^, non-negative otherwise.          }
  71.  
  72. Function PtrDelta(P, Q: Pointer): LongInt;    { Pointer Differential }
  73. Var Lp, Lq : LongInt;
  74. Begin
  75.    Lp := LongInt(Seg(P^)) SHL 4 + Ofs(P^);    { Convert P to LongInt }
  76.    Lq := LongInt(Seg(Q^)) SHL 4 + Ofs(Q^);    { Convert Q to LongInt }
  77.    PtrDelta := Lp - Lq;                { Return Difference    }
  78. End; {PtrDelta}
  79.  
  80.   { Function Below Converts a byte to Printable Hex }        {.CP05}
  81.  
  82. FUNCTION HexB(Arg:byte): _StrByte;
  83. CONST HexTab : ARRAY[0..15] OF Char = '0123456789ABCDEF';
  84. BEGIN HexB := HexTab[Arg SHR 4] + HexTab[Arg AND $F] END;
  85.  
  86.   { Function Below Converts a Word to Printable Hex }        {.CP04}
  87.  
  88. FUNCTION HexW(Arg:Word): _StrWord;
  89. BEGIN HexW := HexB(HI(Arg)) + HexB(LO(Arg)) END;
  90.  
  91.   { Heap Error Function Returns NIL if Allocation Fails }    {.CP11}
  92.  
  93. Function HeapErrorProc(Arg : Word): Integer; FAR;
  94. Begin
  95.     If Arg = 0 Then        { Heap Pointer Being Raised   }
  96.  
  97.         If PtrDelta(System.HeapPtr,_HeapHighWaterMark) > 0
  98.     Then _HeapHighWaterMark := System.HeapPtr;
  99.  
  100.         HeapErrorProc := 1;     { Allow NIL Return by HeapMgr }
  101. End;   {HeapErrorProc}
  102.  
  103. Begin   {Unit Initialization}
  104.     System.HeapError   := @HeapErrorProc;
  105.         _HeapHighWaterMark := System.HeapPtr;
  106.         _HeapOriginalMark  := System.HeapOrg;
  107. End.
  108.